﻿<%
'
'	七色虎建站系统
'	核心文件F.asp
'	v1.2.6 beta2
'	2011.9.3
'	2012.2.25
'	注：外部不要直接引用hu_前缀的变量或函数

'网站全局配置变量
Dim wapstyle,waptitle,wapurl,wapconst,wapreport,wapfavor,waplink,wapday,wapdayname,waphits,wapguest,waplast,waplastc,waplogin,wapdiscuss
Dim stylebodycolor,stylebodyimage,stylefontsize,stylemaincolor,stylemainborder,stylenavcolor,stylenavborder,stylelinkcolor,stylelinkhover,styletipcolor,styleoddcolor,stylecssextend
Dim numtitle,numdiscuss,numlist,numarticle,numbbslist,numtopicmin,numtopicmax,numreplymin,numreplymax,numhit,numbbshit
Dim bbsreg,bbsagree,bbssid,bbsmsgkeep,bbsip,bbsessay,bbsmoney
Dim adminipcheck,admintimecheck,adminupload,adminarticle,adminupdate,adminsize
Dim cssstyle,timediff
Dim tplarticle,tpllist,tpltopic,tplpost

'当前时间
Dim time_start,time_now,time_date,time_time
time_start = Timer
time_now = Now
time_date = Date
time_time = Time

'随机
Dim time_r
time_r=Minute(time_now)&Second(time_now)

'用户IP
Dim user_ip,user_agent
user_ip=getIP()'取Ip地址
user_agent=getAgent()'取浏览器信息

'当前目录地址
Dim http_path

'数据对象
Dim conn

'会话标识
Dim sid
'链接会话标识
Dim a_sid

'返回页面标识
Dim back_url
back_url=forBackUrl()

'数组保存当前账户会话
Dim userArr(3)
' userArr(0)="0"		'ID
' userArr(1)="游客"		'name
' userArr(2)="-1"		'level
' userArr(3)=""			'生日

'系统信息
Dim sysver,sysversion,systime
sysver = "1.2.6.221"
sysversion = "v1.2.6 正式版"
systime = "2012-4-17"

'网站配置
%><!--#include file="config.asp"--><%
'配置出错时启用,降低耦合
If waptitle="" Then waptitle="无名网站"'网站名称
If wapurl="" Then wapurl="74hu.cn"'网站地址
If wapconst="" Then wapconst="left"'网站排版
If bbssid="" Then bbssid="sid"'论坛会话标识
If bbsmoney="" Then bbsmoney="金币"'论坛金币名称
If wapreport<>"1" And wapreport<>"0" Then wapreport="1"'全站显示公告
If waplogin<>"1" And waplogin<>"0" Then waplogin="1"'显示注册登录
If wapfavor<>"1" And wapfavor<>"0" Then wapfavor="1"'首页问候语
If waplink<>"1" And waplink<>"0" Then waplink="1"'首页链接
If waphits<>"1" And waphits<>"0" Then waphits="1"'文章显示点击率
If wapguest<>"1" And wapguest<>"0" Then wapguest="1"'留言审核显示
If bbsip<>"1" And bbsip<>"0" Then bbsip="1"'会员IP检测
If bbsessay<>"1" And bbsessay<>"0" Then bbsessay="1"'会员投稿
If wapdiscuss<>"1" And wapdiscuss<>"0" Then wapdiscuss="0"'文章评论
If Not IsDate(wapday) Then wapday=""'首页倒计时
'字数控制
If Not ifNum(numhit) Then numhit="0"'文章点击种子
If Not ifNum(numlist) Then numlist="10"'文章列表数
If Not ifNum(numbbshit) Then numbbshit="0"'帖子点击种子
If Not ifNum(numbbslist) Then numbbslist="10"'论坛列表数
If Not ifNum(numarticle) Then numarticle="500"'文章每页字数
If Not ifNum(numdiscuss) Then numdiscuss="0"'文章评论最少字数
If Not ifNum(numtopicmin) Then numtopicmin="10"'帖子最少字数
If Not ifNum(numtopicmax) Then numtopicmax="1000"'帖子最多字数
If Not ifNum(numreplymin) Then numreplymin="0"'回帖最少字数
If Not ifNum(numreplymax) Then numreplymax="200"'回帖最多字数
If Not ifNum(bbsmsgkeep) Then bbsmsgkeep="10"'消息保存天数
If Not ifNum(adminsize) Then adminsize="0"'后台上传限制
If ifNum(timediff) Then
	time_now=dateadd("s", timediff, time_now)
	time_date=CDate(Year(time_now)&"-"&Month(time_now)&"-"&Day(time_now))
	time_time=CDate(Hour(time_now)&":"&Minute(time_now)&":"&Second(time_now))
End If

Dim hu_style,hu_badWord,hu_getLeft
hu_style = False' 1.0和2.0 xml不全兼容
hu_getLeft = False' 文章调用字数
hu_badWord = "法轮"' 敏感词过滤

If ifNum(Session("style")) Then wapstyle=Session("style")

If wapstyle="1" And ifWeb Then wapstyle="3"'非wap浏览器访问控制
If wapstyle<>"1" Then hu_style = True'If hu_style Then Exit Function
If ifNum(numtitle) Then hu_getLeft = True'If hu_getLeft Then Exit Function
If wapword<>"" Then hu_badword = hu_badWord &","& wapword

'核心函数
%><!--#include file="libs.asp"--><%

'
' 基本函数，外部可以直接引用
' 要求：共同属性写入底层，这部分只是用于展现
' 函数命名：getMyName,兼容旧系统,暂时没有统一


'显示内容
Sub w(str)'效果不理想,逐步取消这个功能
	Response.Write str
End Sub
'显示内容且停止输出
Sub wn(str)'效果不好,逐步取消这个功能
	Response.Write str
	getClose
	Response.End
End Sub
'网页跳转
Sub r(str)
	Response.Redirect str
End Sub
'得到链接
' Sub tourl(str,name)
	' w newUrl(str,name,"")
' End Sub
' 得到图片
' Sub toimg(str,name)
	' w newImg(str,name,"")
' End Sub
'改写left 中英文长度取定长修整
Function getLeft(str,length)
	getLeft=hu_left(str,length)
End Function
'获取数据
Function getD(str,def)
	Dim tmp
	tmp=getData(str)
	If tmp="" Then getD=def:Exit Function
	tmp=hu_common(tmp)
	tmp=hu_encode(tmp)
	getD=tmp
End Function
'不过滤获取数据
Function getDD(str,def)
	Dim tmp
	tmp=getData(str)
	If tmp="" Then getDD=def:Exit Function
	getDD=tmp
End Function
'完全过滤获取数据
Function getFilter(str,def)
	Dim tmp
	tmp=getData(str)
	If tmp="" Then getFilter=def:Exit Function
	getFilter=hu_filter(tmp)
End Function
'完全过滤数据
Function setFilter(str)
	setFilter=hu_filter(str)
End Function
'获取数字
Function getN(str,def)
	Dim tmp
	tmp=getData(str)
	If tmp="" Then getN=def:Exit Function
	If Not IsNumeric(tmp) Then getN=def:Exit Function
	getN=int(tmp)'避免非十进制 用clng会溢出
End Function
'从终端获取数据
Function getData(str)
	If hu_isNull(str) Then Exit Function
	Dim tmp
	tmp=Trim(Request.QueryString(str))
	If tmp="" Then tmp=Trim(Request.Form(str))
	' tmp=Replace(tmp,"%0c","<",1,-1,1)
	' tmp=Replace(tmp,"%0e",">",1,-1,1)
	' tmp=Replace(tmp,"%2f","/",1,-1,1)
	getData=tmp
End Function
'敏感词过滤
Function changeWord(str)
	changeWord = hu_changeWord(str,hu_badWord,"**")
End Function
'随机显示字符
Function getRndStr(str,pattern)
	getRndStr=hu_rndObj(str,pattern)
End Function
'清除缓存
Sub cache(str)
	If str Then Exit Sub
	Response.Buffer = True
	Response.Expires = 0
	Response.ExpiresAbsolute = time_now - 1
	Response.CacheControl = "no-cache"
	Response.AddHeader "Expires",time_date
	Response.AddHeader "Pragma","no-cache"
	Response.AddHeader "Cache-Control","private, no-cache, must-revalidate"
End Sub
'获取客户端IP
Function getIP()
   Dim tmp
   tmp = Trim(Request.ServerVariables("HTTP_X_FORWARDED_FOR"))
   If tmp="" Then tmp = Trim(Request.ServerVariables("REMOTE_ADDR"))
   If Instr(tmp,"'")>0 Or tmp="" Then tmp="0.0.0.0"
   getIP = tmp
End Function
Function getAgent()
	Dim tmp
	tmp = Request.ServerVariables("HTTP_USER_AGENT")
	getAgent = tmp
End Function
'2.0编辑后写入数据库
Function forSaveByWeb(str)
	If hu_isNull(str) Then Exit Function
	str=Trim(str)
	str=Replace(str,"&nbsp;"," ")
	str=Replace(str,"&amp;","&#38;")
	str=Replace(str,"$$","$")'兼容1.0
	str=Replace(str,"","")
	str=Replace(str,vbnewline,"\\")
	str=Replace(str,VbCrLf,"\\")
	forSaveByWeb=str
End Function
'动态友链
Function getLink(str)
	Dim max,num,arr_
	max=str
	If instr(str,",")>0 Then
		arr_=Split(str,",")
		max=arr_(0)
		num=arr_(1)
	End If
	getLink=toplink(max,num)
End Function
'判断全字母
Function ifLetter(str)
	ifLetter=hu_isLetters(str)
End Function
'判断全数字
Function ifNumeric(str)
	ifNumeric=hu_isNumeric(str)
End Function
'判断全数字,用于快速检查
Function ifNum(str)
	ifNum=hu_isNumber(str)
End Function
'生成验证码
Function getCheckCode()
	randomize
	getCheckCode=Int((9000)*Rnd +1000)'不能做修改,必须保证4位
End Function
'验证登录
Function iflogin()
	iflogin=True
	If userArr(0)=0 Then iflogin=False
End Function
'是否支持wml
Function ifWeb()
	Dim agent
	agent = Request.ServerVariables("HTTP_USER_AGENT")
	ifWeb = False
	If InStr(agent,"Mozilla")=0 Then Exit Function
	Select Case True
	Case InStr(agent,"Opera")>0
	Case InStr(agent,"Symbian")>0
	Case InStr(agent,"UC")>0
	Case InStr(agent,"CE")>0
	Case InStr(agent,"SmartPhone")>0
	Case InStr(agent,"NetFront")>0
	Case Else
		ifWeb = True
	End Select
End Function
'获取当前目录
Function getServerPath()
	Dim Path_
	Path_="http://" & Request.ServerVariables("server_name") & Request.ServerVariables("script_name")
	getServerPath=Left(Path_,InStrRev(Path_,"/"))
End Function
'将当前页面地址转换成特定字符串
Function forBackUrl
	Dim Path_,Url_
	Path_= Request.ServerVariables("server_name") & Request.ServerVariables("script_name") & "?_m"& time_r &"=1"
	Url_=Request.ServerVariables("QUERY_STRING")
	If Url_<>"" Then Path_=Path_&"&"&Url_
	Url_=urlEncode(Path_)
	forBackUrl=Url_
End Function
'将指定字符串转换成地址
Function getBackUrl(str)
	str=Trim(str)
	if str<>"" then
		str=nowml(urlDecode(str))
		str="http://"&str
	else
		str=http_path&"?bug"&time_r&"=1"
	end if
	getBackUrl=str
End Function
'检查组件是否已经安装
Function ifObjInstalled(str)
	ifObjInstalled=hu_isObjInstalled(str)
End Function
'数字加密(beta版) 仅测试过4位数字
Function numEncode(str)
	Randomize()
	retn=int(rnd()*90000000)+10000000
	lenr=len(str)
	modn=4'可以存在于application
	keyn=len(waplast&waplogo) mod modn'可以存在于application
	rndx=int(rnd()*10)
	rndt=rndx mod modn
	abst=abs(rndt-keyn)+1'最大4,最小1
	absr=abs(rndt-lenr)+1'最大str长度,最小1
	absq=abs(abst-absr)+1
	absw=abs(lenr-absr)
	numEncode=left(rndx&mid(retn,1,abst)&lenr&right(str,1)&mid(str,1,absr)&mid(retn&retn,lenr,absq)&mid(str,absr+1,absw)&retn,18)
End Function
'数字解密(beta版)
Function numDecode(str)
	If len(str)<>18 Then numDecode=time_r:Exit Function'假使str必须是18位
	modn=4'可以存在于application
	rndt=int(left(str,1)) mod modn
	keyn=len(waplast&waplogo) mod modn
	abst=abs(rndt-keyn)+1'最大4,最小1
	lenr=int(mid(str,abst+2,1))
	absr=abs(rndt-lenr)+1'最大str长度,最小1
	absq=abs(abst-absr)+1
	absw=abs(lenr-absr)
	strr=mid(str,abst+3,1)'str right 1
	stra=mid(str,abst+4,absr)
	If absr>lenr Or absr=lenr Then
		str=left(stra,lenr)
	Else
		str=stra&mid(str,abst+4+absr+absq,absw)
	End If
	numDecode=str
End Function
%>